home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / emfmt / msg.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-05-08  |  6.7 KB  |  182 lines
  1. VERSION 2.00
  2. Begin Form Form1 
  3.    Caption         =   "EM_FMTLINES DEMO"
  4.    ClientHeight    =   1995
  5.    ClientLeft      =   1740
  6.    ClientTop       =   1500
  7.    ClientWidth     =   6885
  8.    Height          =   2400
  9.    Left            =   1680
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   1995
  12.    ScaleWidth      =   6885
  13.    Top             =   1155
  14.    Width           =   7005
  15.    Begin CommandButton Command3 
  16.       Caption         =   "&Print"
  17.       Height          =   375
  18.       Left            =   3000
  19.       TabIndex        =   3
  20.       Top             =   1320
  21.       Width           =   1335
  22.    End
  23.    Begin CommandButton Command2 
  24.       Caption         =   "CR-CR-LF = O&FF"
  25.       FontBold        =   0   'False
  26.       FontItalic      =   0   'False
  27.       FontName        =   "MS Sans Serif"
  28.       FontSize        =   8.25
  29.       FontStrikethru  =   0   'False
  30.       FontUnderline   =   0   'False
  31.       Height          =   375
  32.       Left            =   3000
  33.       TabIndex        =   2
  34.       Top             =   840
  35.       Width           =   1335
  36.    End
  37.    Begin CommandButton Command1 
  38.       Caption         =   "CR-CR-LF = &ON"
  39.       FontBold        =   0   'False
  40.       FontItalic      =   0   'False
  41.       FontName        =   "MS Sans Serif"
  42.       FontSize        =   8.25
  43.       FontStrikethru  =   0   'False
  44.       FontUnderline   =   0   'False
  45.       Height          =   375
  46.       Left            =   3000
  47.       TabIndex        =   1
  48.       Top             =   360
  49.       Width           =   1335
  50.    End
  51.    Begin TextBox Text1 
  52.       Height          =   1095
  53.       Left            =   360
  54.       MultiLine       =   -1  'True
  55.       TabIndex        =   0
  56.       Text            =   "This text does not return CR-CR-LF when it wraps text at the end of the line."
  57.       Top             =   600
  58.       Width           =   2295
  59.    End
  60.    Begin Label Label2 
  61.       Caption         =   "Select the desired command button to turn EM_FMTLINES on or off.                                                          Then select Print to see the results."
  62.       Height          =   1455
  63.       Left            =   4560
  64.       TabIndex        =   7
  65.       Top             =   360
  66.       Width           =   2055
  67.    End
  68.    Begin Label LabelOFF 
  69.       Caption         =   "OFF"
  70.       ForeColor       =   &H000000FF&
  71.       Height          =   255
  72.       Left            =   1560
  73.       TabIndex        =   6
  74.       Top             =   240
  75.       Width           =   495
  76.    End
  77.    Begin Label LabelON 
  78.       Caption         =   "ON"
  79.       ForeColor       =   &H00008000&
  80.       Height          =   255
  81.       Left            =   1560
  82.       TabIndex        =   5
  83.       Top             =   240
  84.       Width           =   495
  85.    End
  86.    Begin Label Label1 
  87.       Caption         =   "CR-CR-LF = "
  88.       Height          =   255
  89.       Left            =   360
  90.       TabIndex        =   4
  91.       Top             =   240
  92.       Width           =   1095
  93.    End
  94. Option Explicit
  95. Declare Function SendMessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long
  96. Const WM_USER = &H400
  97. Const EM_FMTLINES = WM_USER + 24
  98. Sub Command1_Click ()
  99. Dim rtn%
  100. 'Turning ON and OFF the CR-CR-LF could be done at various
  101. 'points and times within program execution.  If desired,
  102. 'this could be done when the form is loaded and be the
  103. 'default for all remaining operations on the text, or it
  104. 'could be turned on and off when needed.  It all depends
  105. 'on what the programmer needs to do with the text and when.
  106. 'For this example set text
  107. Text1 = "This text will return CR-CR-LF when it wraps text at the end of the line."
  108. 'Turn on CR-CR-LF combination
  109. rtn% = SendMessage(Text1.hWnd, EM_FMTLINES, True, 0&)
  110. 'Show ON label
  111. LabelON.ZOrder 0
  112. End Sub
  113. Sub Command2_Click ()
  114. Dim rtn%
  115. 'Turning ON and OFF the CR-CR-LF could be done at various
  116. 'points and times within program execution.  If desired,
  117. 'this could be done when the form is loaded and be the
  118. 'default for all remaining operations on the text, or it
  119. 'could be turned on and off when needed.  It all depends
  120. 'on what the programmer needs to do with the text and when.
  121. 'For this example set text
  122. Text1 = "This text does not return CR-CR-LF when it wraps text at the end of the line."
  123. 'Turn off CR-CR-LF combination
  124. rtn% = SendMessage(Text1.hWnd, EM_FMTLINES, False, 0&)
  125. 'Show ON label
  126. LabelOFF.ZOrder 0
  127. End Sub
  128. Sub Command3_Click ()
  129. Screen.MousePointer = 11    'Hourglass
  130. 'Set printer object to character mode for this example
  131. Printer.ScaleMode = 4
  132. 'Normally this is where we would set the CurrentY property
  133. 'Print textbox
  134. Call StripCR_Print(Text1, 15)
  135. '15 could be any valid character position. For this example we will
  136. 'use 15 as the character position (column) to print the text.
  137. 'The sub expects a Single, so, as an example, we could pass it 15.3
  138. 'if we needed to move the text slighty right or 14.8 to move it
  139. 'slightly left.
  140. Printer.EndDoc
  141. Screen.MousePointer = 0     'Default
  142. End Sub
  143. Sub StripCR_Print (ByVal Text$, ByVal CurXPos!)
  144. Dim Pos%, StartPos%, InStrPos%
  145. 'Before calling this sub the programmer must set the
  146. 'CurrentY position and pass the text and the CurrentX
  147. 'position as parameters.  This sub uses the CurXPos!
  148. 'to set the printer object CurrentX position before
  149. 'printing each line.
  150. 'We use CurXPos here as a Single.  That is because we
  151. 'are using the character scalemode (4) for the printer object
  152. 'and it can accept a single for precision placement of the
  153. 'CurrentX property.
  154. 'If we were to use some other scalemode then we must change
  155. 'the datatype of CurXPos to reflect the values that the
  156. 'printer object will accept.  i.e. For twips use integer.
  157. 'If Text$ is empty then exit the sub - no need to print
  158. If Text$ = "" Then Exit Sub
  159. 'First strip the extra CR that is returned when setting
  160. 'the EM_FMTLINES message to True.
  161. Do While InStr(Text$, (Chr$(13) & Chr$(13)))
  162.     Pos% = InStr(Text$, (Chr$(13) & Chr$(13)))
  163.     'Delete extra CR
  164.     Text$ = Mid$(Text$, 1, Pos% - 1) + Mid$(Text$, Pos% + 1)
  165. StartPos% = 1    'Initialize
  166. InStrPos% = 1    'Initialize
  167. Do While StartPos% <= Len(Text$)
  168.     'Search for the last character in the CR-LF combination - chr$(10)
  169.     InStrPos% = InStr(StartPos%, Text$, Chr$(10))
  170.     'If InStrPos% = 0 then print last line and exit sub
  171.     If InStrPos% = 0 Then
  172.         Printer.CurrentX = CurXPos!
  173.         Printer.Print Mid$(Text$, StartPos%);
  174.         Exit Sub
  175.     End If
  176.     'Print line
  177.     Printer.CurrentX = CurXPos!
  178.     Printer.Print Mid$(Text$, StartPos%, InStrPos% - StartPos% + 1);
  179.     'Set new StartPos%
  180.     StartPos% = InStrPos% + 1
  181. End Sub
  182.